home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkBind.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  75.9 KB  |  2,716 lines
  1. /* 
  2.  * tkBind.c --
  3.  *
  4.  *    This file provides procedures that associate Tcl commands
  5.  *    with X events or sequences of X events.
  6.  *
  7.  * Copyright (c) 1989-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tkBind.c 1.110 96/03/22 11:54:55
  14.  */
  15.  
  16. #include "tkPort.h"
  17. #include "tkInt.h"
  18.  
  19. /*
  20.  * The structure below represents a binding table.  A binding table
  21.  * represents a domain in which event bindings may occur.  It includes
  22.  * a space of objects relative to which events occur (usually windows,
  23.  * but not always), a history of recent events in the domain, and
  24.  * a set of mappings that associate particular Tcl commands with sequences
  25.  * of events in the domain.  Multiple binding tables may exist at once,
  26.  * either because there are multiple applications open, or because there
  27.  * are multiple domains within an application with separate event
  28.  * bindings for each (for example, each canvas widget has a separate
  29.  * binding table for associating events with the items in the canvas).
  30.  *
  31.  * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
  32.  * below 30.  To see this, consider a triple mouse button click while
  33.  * the Shift key is down (and auto-repeating).  There may be as many
  34.  * as 3 auto-repeat events after each mouse button press or release
  35.  * (see the first large comment block within Tk_BindEvent for more on
  36.  * this), for a total of 20 events to cover the three button presses
  37.  * and two intervening releases.  If you reduce EVENT_BUFFER_SIZE too
  38.  * much, shift multi-clicks will be lost.
  39.  * 
  40.  */
  41.  
  42. #define EVENT_BUFFER_SIZE 30
  43. typedef struct BindingTable {
  44.     XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
  45.                      * (higher indices are for more recent
  46.                      * events). */
  47.     int detailRing[EVENT_BUFFER_SIZE];    /* "Detail" information (keySym or
  48.                      * button or 0) for each entry in
  49.                      * eventRing. */
  50.     int curEvent;            /* Index in eventRing of most recent
  51.                      * event.  Newer events have higher
  52.                      * indices. */
  53.     Tcl_HashTable patternTable;        /* Used to map from an event to a list
  54.                      * of patterns that may match that
  55.                      * event.  Keys are PatternTableKey
  56.                      * structs, values are (PatSeq *). */
  57.     Tcl_HashTable objectTable;        /* Used to map from an object to a list
  58.                      * of patterns associated with that
  59.                      * object.  Keys are ClientData,
  60.                      * values are (PatSeq *). */
  61.     Tcl_Interp *interp;            /* Interpreter in which commands are
  62.                      * executed. */
  63. } BindingTable;
  64.  
  65. /*
  66.  * Structures of the following form are used as keys in the patternTable
  67.  * for a binding table:
  68.  */
  69.  
  70. typedef struct PatternTableKey {
  71.     ClientData object;        /* Identifies object (or class of objects)
  72.                  * relative to which event occurred.  For
  73.                  * example, in the widget binding table for
  74.                  * an application this is the path name of
  75.                  * a widget, or a widget class, or "all". */
  76.     int type;            /* Type of event (from X). */
  77.     int detail;            /* Additional information, such as
  78.                  * keysym or button, or 0 if nothing
  79.                  * additional.*/
  80. } PatternTableKey;
  81.  
  82. /*
  83.  * The following structure defines a pattern, which is matched
  84.  * against X events as part of the process of converting X events
  85.  * into Tcl commands.
  86.  */
  87.  
  88. typedef struct Pattern {
  89.     int eventType;        /* Type of X event, e.g. ButtonPress. */
  90.     int needMods;        /* Mask of modifiers that must be
  91.                  * present (0 means no modifiers are
  92.                  * required). */
  93.     int detail;            /* Additional information that must
  94.                  * match event.  Normally this is 0,
  95.                  * meaning no additional information
  96.                  * must match.  For KeyPress and
  97.                  * KeyRelease events, a keySym may
  98.                  * be specified to select a
  99.                  * particular keystroke (0 means any
  100.                  * keystrokes).  For button events,
  101.                  * specifies a particular button (0
  102.                  * means any buttons are OK). */
  103. } Pattern;
  104.  
  105. /*
  106.  * The structure below defines a pattern sequence, which consists
  107.  * of one or more patterns.  In order to trigger, a pattern
  108.  * sequence must match the most recent X events (first pattern
  109.  * to most recent event, next pattern to next event, and so on).
  110.  */
  111.  
  112. typedef struct PatSeq {
  113.     int numPats;        /* Number of patterns in sequence
  114.                  * (usually 1). */
  115.     char *command;        /* Command to invoke when this
  116.                  * pattern sequence matches (malloc-ed). */
  117.     int flags;            /* Miscellaneous flag values;  see
  118.                  * below for definitions. */
  119.     struct PatSeq *nextSeqPtr;
  120.                 /* Next in list of all pattern
  121.                  * sequences that have the same
  122.                  * initial pattern.  NULL means
  123.                  * end of list. */
  124.     Tcl_HashEntry *hPtr;    /* Pointer to hash table entry for
  125.                  * the initial pattern.  This is the
  126.                  * head of the list of which nextSeqPtr
  127.                  * forms a part. */
  128.     ClientData object;        /* Identifies object with which event is
  129.                  * associated (e.g. window). */
  130.     struct PatSeq *nextObjPtr;
  131.                 /* Next in list of all pattern
  132.                  * sequences for the same object
  133.                  * (NULL for end of list).  Needed to
  134.                  * implement Tk_DeleteAllBindings. */
  135.     Pattern pats[1];        /* Array of "numPats" patterns.  Only
  136.                  * one element is declared here but
  137.                  * in actuality enough space will be
  138.                  * allocated for "numPats" patterns.
  139.                  * To match, pats[0] must match event
  140.                  * n, pats[1] must match event n-1,
  141.                  * etc. */
  142. } PatSeq;
  143.  
  144. /*
  145.  * Flag values for PatSeq structures:
  146.  *
  147.  * PAT_NEARBY        1 means that all of the events matching
  148.  *            this sequence must occur with nearby X
  149.  *            and Y mouse coordinates and close in time.
  150.  *            This is typically used to restrict multiple
  151.  *            button presses.
  152.  */
  153.  
  154. #define PAT_NEARBY        1
  155.  
  156. /*
  157.  * Constants that define how close together two events must be
  158.  * in milliseconds or pixels to meet the PAT_NEARBY constraint:
  159.  */
  160.  
  161. #define NEARBY_PIXELS        5
  162. #define NEARBY_MS        500
  163.  
  164. /*
  165.  * One of the following structures exists for each interpreter,
  166.  * associated with the key "tkBind".  This structure keeps track
  167.  * of the current display and screen in the interpreter, so that
  168.  * a script can be invoked whenever the display/screen changes
  169.  * (the script does things like point tkPriv at a display-specific
  170.  * structure).
  171.  */
  172.  
  173. typedef struct ScreenInfo {
  174.     TkDisplay *curDispPtr;    /* Display for last binding command invoked
  175.                  * in this application. */
  176.     int curScreenIndex;        /* Index of screen for last binding command. */
  177.     int bindingDepth;        /* Number of active instances of Tk_BindEvent
  178.                  * in this application. */
  179. } ScreenInfo;
  180.  
  181. /*
  182.  * In X11R4 and earlier versions, XStringToKeysym is ridiculously
  183.  * slow.  The data structure and hash table below, along with the
  184.  * code that uses them, implement a fast mapping from strings to
  185.  * keysyms.  In X11R5 and later releases XStringToKeysym is plenty
  186.  * fast so this stuff isn't needed.  The #define REDO_KEYSYM_LOOKUP
  187.  * is normally undefined, so that XStringToKeysym gets used.  It
  188.  * can be set in the Makefile to enable the use of the hash table
  189.  * below.
  190.  */
  191.  
  192. #ifdef REDO_KEYSYM_LOOKUP
  193. typedef struct {
  194.     char *name;                /* Name of keysym. */
  195.     KeySym value;            /* Numeric identifier for keysym. */
  196. } KeySymInfo;
  197. static KeySymInfo keyArray[] = {
  198. #ifndef lint
  199. #include "ks_names.h"
  200. #endif
  201.     {(char *) NULL, 0}
  202. };
  203. static Tcl_HashTable keySymTable;    /* keyArray hashed by keysym value. */
  204. static Tcl_HashTable nameTable;        /* keyArray hashed by keysym name. */
  205. #endif /* REDO_KEYSYM_LOOKUP */
  206.  
  207. static int initialized = 0;
  208.  
  209. /*
  210.  * A hash table is kept to map from the string names of event
  211.  * modifiers to information about those modifiers.  The structure
  212.  * for storing this information, and the hash table built at
  213.  * initialization time, are defined below.
  214.  */
  215.  
  216. typedef struct {
  217.     char *name;            /* Name of modifier. */
  218.     int mask;            /* Button/modifier mask value,                             * such as Button1Mask. */
  219.     int flags;            /* Various flags;  see below for
  220.                  * definitions. */
  221. } ModInfo;
  222.  
  223. /*
  224.  * Flags for ModInfo structures:
  225.  *
  226.  * DOUBLE -        Non-zero means duplicate this event,
  227.  *            e.g. for double-clicks.
  228.  * TRIPLE -        Non-zero means triplicate this event,
  229.  *            e.g. for triple-clicks.
  230.  */
  231.  
  232. #define DOUBLE        1
  233. #define TRIPLE        2
  234.  
  235. /*
  236.  * The following special modifier mask bits are defined, to indicate
  237.  * logical modifiers such as Meta and Alt that may float among the
  238.  * actual modifier bits.
  239.  */
  240.  
  241. #define META_MASK    (AnyModifier<<1)
  242. #define ALT_MASK    (AnyModifier<<2)
  243.  
  244. static ModInfo modArray[] = {
  245.     {"Control",        ControlMask,    0},
  246.     {"Shift",        ShiftMask,    0},
  247.     {"Lock",        LockMask,    0},
  248.     {"Meta",        META_MASK,    0},
  249.     {"M",        META_MASK,    0},
  250.     {"Alt",        ALT_MASK,    0},
  251.     {"B1",        Button1Mask,    0},
  252.     {"Button1",        Button1Mask,    0},
  253.     {"B2",        Button2Mask,    0},
  254.     {"Button2",        Button2Mask,    0},
  255.     {"B3",        Button3Mask,    0},
  256.     {"Button3",        Button3Mask,    0},
  257.     {"B4",        Button4Mask,    0},
  258.     {"Button4",        Button4Mask,    0},
  259.     {"B5",        Button5Mask,    0},
  260.     {"Button5",        Button5Mask,    0},
  261.     {"Mod1",        Mod1Mask,    0},
  262.     {"M1",        Mod1Mask,    0},
  263.     {"Command",        Mod1Mask,    0},
  264.     {"Mod2",        Mod2Mask,    0},
  265.     {"M2",        Mod2Mask,    0},
  266.     {"Option",        Mod2Mask,    0},
  267.     {"Mod3",        Mod3Mask,    0},
  268.     {"M3",        Mod3Mask,    0},
  269.     {"Mod4",        Mod4Mask,    0},
  270.     {"M4",        Mod4Mask,    0},
  271.     {"Mod5",        Mod5Mask,    0},
  272.     {"M5",        Mod5Mask,    0},
  273.     {"Double",        0,        DOUBLE},
  274.     {"Triple",        0,        TRIPLE},
  275.     {"Any",        0,        0},    /* Ignored: historical relic. */
  276.     {NULL,        0,        0}
  277. };
  278. static Tcl_HashTable modTable;
  279.  
  280. /*
  281.  * This module also keeps a hash table mapping from event names
  282.  * to information about those events.  The structure, an array
  283.  * to use to initialize the hash table, and the hash table are
  284.  * all defined below.
  285.  */
  286.  
  287. typedef struct {
  288.     char *name;            /* Name of event. */
  289.     int type;            /* Event type for X, such as
  290.                  * ButtonPress. */
  291.     int eventMask;        /* Mask bits (for XSelectInput)
  292.                  * for this event type. */
  293. } EventInfo;
  294.  
  295. /*
  296.  * Note:  some of the masks below are an OR-ed combination of
  297.  * several masks.  This is necessary because X doesn't report
  298.  * up events unless you also ask for down events.  Also, X
  299.  * doesn't report button state in motion events unless you've
  300.  * asked about button events.
  301.  */
  302.  
  303. static EventInfo eventArray[] = {
  304.     {"Motion",        MotionNotify,
  305.         ButtonPressMask|PointerMotionMask},
  306.     {"Button",        ButtonPress,        ButtonPressMask},
  307.     {"ButtonPress",    ButtonPress,        ButtonPressMask},
  308.     {"ButtonRelease",    ButtonRelease,
  309.         ButtonPressMask|ButtonReleaseMask},
  310.     {"Colormap",    ColormapNotify,        ColormapChangeMask},
  311.     {"Enter",        EnterNotify,        EnterWindowMask},
  312.     {"Leave",        LeaveNotify,        LeaveWindowMask},
  313.     {"Expose",        Expose,            ExposureMask},
  314.     {"FocusIn",        FocusIn,        FocusChangeMask},
  315.     {"FocusOut",    FocusOut,        FocusChangeMask},
  316.     {"Key",        KeyPress,        KeyPressMask},
  317.     {"KeyPress",    KeyPress,        KeyPressMask},
  318.     {"KeyRelease",    KeyRelease,
  319.         KeyPressMask|KeyReleaseMask},
  320.     {"Property",    PropertyNotify,        PropertyChangeMask},
  321.     {"Circulate",    CirculateNotify,    StructureNotifyMask},
  322.     {"Configure",    ConfigureNotify,    StructureNotifyMask},
  323.     {"Destroy",        DestroyNotify,        StructureNotifyMask},
  324.     {"Gravity",        GravityNotify,        StructureNotifyMask},
  325.     {"Map",        MapNotify,        StructureNotifyMask},
  326.     {"Reparent",    ReparentNotify,        StructureNotifyMask},
  327.     {"Unmap",        UnmapNotify,        StructureNotifyMask},
  328.     {"Visibility",    VisibilityNotify,    VisibilityChangeMask},
  329.     {"Activate",    ActivateNotify,        ActivateMask},
  330.     {"Deactivate",    DeactivateNotify,    ActivateMask},
  331.     {(char *) NULL,    0,            0}
  332. };
  333. static Tcl_HashTable eventTable;
  334.  
  335. /*
  336.  * The defines and table below are used to classify events into
  337.  * various groups.  The reason for this is that logically identical
  338.  * fields (e.g. "state") appear at different places in different
  339.  * types of events.  The classification masks can be used to figure
  340.  * out quickly where to extract information from events.
  341.  */
  342.  
  343. #define KEY_BUTTON_MOTION    0x1
  344. #define CROSSING        0x2
  345. #define FOCUS            0x4
  346. #define EXPOSE            0x8
  347. #define VISIBILITY        0x10
  348. #define CREATE            0x20
  349. #define MAP            0x40
  350. #define REPARENT        0x80
  351. #define CONFIG            0x100
  352. #define CONFIG_REQ        0x200
  353. #define RESIZE_REQ        0x400
  354. #define GRAVITY            0x800
  355. #define PROP            0x1000
  356. #define SEL_CLEAR        0x2000
  357. #define SEL_REQ            0x4000
  358. #define SEL_NOTIFY        0x8000
  359. #define COLORMAP        0x10000
  360. #define MAPPING            0x20000
  361. #define ACTIVATE        0x40000
  362.  
  363. static int flagArray[TK_LASTEVENT] = {
  364.    /* Not used */        0,
  365.    /* Not used */        0,
  366.    /* KeyPress */        KEY_BUTTON_MOTION,
  367.    /* KeyRelease */        KEY_BUTTON_MOTION,
  368.    /* ButtonPress */        KEY_BUTTON_MOTION,
  369.    /* ButtonRelease */        KEY_BUTTON_MOTION,
  370.    /* MotionNotify */        KEY_BUTTON_MOTION,
  371.    /* EnterNotify */        CROSSING,
  372.    /* LeaveNotify */        CROSSING,
  373.    /* FocusIn */        FOCUS,
  374.    /* FocusOut */        FOCUS,
  375.    /* KeymapNotify */        0,
  376.    /* Expose */            EXPOSE,
  377.    /* GraphicsExpose */        EXPOSE,
  378.    /* NoExpose */        0,
  379.    /* VisibilityNotify */    VISIBILITY,
  380.    /* CreateNotify */        CREATE,
  381.    /* DestroyNotify */        0,
  382.    /* UnmapNotify */        0,
  383.    /* MapNotify */        MAP,
  384.    /* MapRequest */        0,
  385.    /* ReparentNotify */        REPARENT,
  386.    /* ConfigureNotify */    CONFIG,
  387.    /* ConfigureRequest */    CONFIG_REQ,
  388.    /* GravityNotify */        0,
  389.    /* ResizeRequest */        RESIZE_REQ,
  390.    /* CirculateNotify */    0,
  391.    /* CirculateRequest */    0,
  392.    /* PropertyNotify */        PROP,
  393.    /* SelectionClear */        SEL_CLEAR,
  394.    /* SelectionRequest */    SEL_REQ,
  395.    /* SelectionNotify */    SEL_NOTIFY,
  396.    /* ColormapNotify */        COLORMAP,
  397.    /* ClientMessage */        0,
  398.    /* MappingNotify */        MAPPING,
  399.    /* Activate */        ACTIVATE,        
  400.    /* Deactivate */        ACTIVATE
  401. };
  402.  
  403. /*
  404.  * Prototypes for local procedures defined in this file:
  405.  */
  406.  
  407. static void        ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
  408.                 char *dispName, int screenIndex));
  409. static void        ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
  410.                 char *before, XEvent *eventPtr, KeySym keySym,
  411.                 Tcl_DString *dsPtr));
  412. static PatSeq *        FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
  413.                 BindingTable *bindPtr, ClientData object,
  414.                 char *eventString, int create,
  415.                 unsigned long *maskPtr));
  416. static void        FreeScreenInfo _ANSI_ARGS_((ClientData clientData,
  417.                 Tcl_Interp *interp));
  418. static char *        GetField _ANSI_ARGS_((char *p, char *copy, int size));
  419. static KeySym        GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
  420.                 XEvent *eventPtr));
  421. static void        InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
  422. static PatSeq *        MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
  423.                 BindingTable *bindPtr, PatSeq *psPtr));
  424.  
  425. /*
  426.  *--------------------------------------------------------------
  427.  *
  428.  * Tk_CreateBindingTable --
  429.  *
  430.  *    Set up a new domain in which event bindings may be created.
  431.  *
  432.  * Results:
  433.  *    The return value is a token for the new table, which must
  434.  *    be passed to procedures like Tk_CreatBinding.
  435.  *
  436.  * Side effects:
  437.  *    Memory is allocated for the new table.
  438.  *
  439.  *--------------------------------------------------------------
  440.  */
  441.  
  442. Tk_BindingTable
  443. Tk_CreateBindingTable(interp)
  444.     Tcl_Interp *interp;        /* Interpreter to associate with the binding
  445.                  * table:  commands are executed in this
  446.                  * interpreter. */
  447. {
  448.     register BindingTable *bindPtr;
  449.     int i;
  450.  
  451.     /*
  452.      * If this is the first time a binding table has been created,
  453.      * initialize the global data structures.
  454.      */
  455.  
  456.     if (!initialized) {
  457.     register Tcl_HashEntry *hPtr;
  458.     register ModInfo *modPtr;
  459.     register EventInfo *eiPtr;
  460.     int dummy;
  461.  
  462. #ifdef REDO_KEYSYM_LOOKUP
  463.     register KeySymInfo *kPtr;
  464.  
  465.     Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
  466.     Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
  467.     for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
  468.         hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
  469.         Tcl_SetHashValue(hPtr, kPtr->value);
  470.         hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
  471.             &dummy);
  472.         Tcl_SetHashValue(hPtr, kPtr->name);
  473.     }
  474. #endif /* REDO_KEYSYM_LOOKUP */
  475.  
  476.     initialized = 1;
  477.     
  478.     Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
  479.     for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
  480.         hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
  481.         Tcl_SetHashValue(hPtr, modPtr);
  482.     }
  483.     
  484.     Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
  485.     for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
  486.         hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
  487.         Tcl_SetHashValue(hPtr, eiPtr);
  488.     }
  489.     }
  490.  
  491.     /*
  492.      * Create and initialize a new binding table.
  493.      */
  494.  
  495.     bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
  496.     for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
  497.     bindPtr->eventRing[i].type = -1;
  498.     }
  499.     bindPtr->curEvent = 0;
  500.     Tcl_InitHashTable(&bindPtr->patternTable,
  501.         sizeof(PatternTableKey)/sizeof(int));
  502.     Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
  503.     bindPtr->interp = interp;
  504.     return (Tk_BindingTable) bindPtr;
  505. }
  506.  
  507. /*
  508.  *--------------------------------------------------------------
  509.  *
  510.  * Tk_DeleteBindingTable --
  511.  *
  512.  *    Destroy a binding table and free up all its memory.
  513.  *    The caller should not use bindingTable again after
  514.  *    this procedure returns.
  515.  *
  516.  * Results:
  517.  *    None.
  518.  *
  519.  * Side effects:
  520.  *    Memory is freed.
  521.  *
  522.  *--------------------------------------------------------------
  523.  */
  524.  
  525. void
  526. Tk_DeleteBindingTable(bindingTable)
  527.     Tk_BindingTable bindingTable;    /* Token for the binding table to
  528.                      * destroy. */
  529. {
  530.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  531.     PatSeq *psPtr, *nextPtr;
  532.     Tcl_HashEntry *hPtr;
  533.     Tcl_HashSearch search;
  534.  
  535.     /*
  536.      * Find and delete all of the patterns associated with the binding
  537.      * table.
  538.      */
  539.  
  540.     for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
  541.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  542.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  543.         psPtr != NULL; psPtr = nextPtr) {
  544.         nextPtr = psPtr->nextSeqPtr;
  545.         ckfree((char *) psPtr->command);
  546.         ckfree((char *) psPtr);
  547.     }
  548.     }
  549.  
  550.     /*
  551.      * Clean up the rest of the information associated with the
  552.      * binding table.
  553.      */
  554.  
  555.     Tcl_DeleteHashTable(&bindPtr->patternTable);
  556.     Tcl_DeleteHashTable(&bindPtr->objectTable);
  557.     ckfree((char *) bindPtr);
  558. }
  559.  
  560. /*
  561.  *--------------------------------------------------------------
  562.  *
  563.  * Tk_CreateBinding --
  564.  *
  565.  *    Add a binding to a binding table, so that future calls to
  566.  *    Tk_BindEvent may execute the command in the binding.
  567.  *
  568.  * Results:
  569.  *    The return value is 0 if an error occurred while setting
  570.  *    up the binding.  In this case, an error message will be
  571.  *    left in interp->result.  If all went well then the return
  572.  *    value is a mask of the event types that must be made
  573.  *    available to Tk_BindEvent in order to properly detect when
  574.  *    this binding triggers.  This value can be used to determine
  575.  *    what events to select for in a window, for example.
  576.  *
  577.  * Side effects:
  578.  *    The new binding may cause future calls to Tk_BindEvent to
  579.  *    behave differently than they did previously.
  580.  *
  581.  *--------------------------------------------------------------
  582.  */
  583.  
  584. unsigned long
  585. #ifdef STk_CODE
  586. Tk_CreateBinding(interp, bindingTable, object, eventString, command, str1, str2)
  587. #else
  588. Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
  589. #endif
  590.     Tcl_Interp *interp;            /* Used for error reporting. */
  591.     Tk_BindingTable bindingTable;    /* Table in which to create binding. */
  592.     ClientData object;            /* Token for object with which binding
  593.                      * is associated. */
  594.     char *eventString;            /* String describing event sequence
  595.                      * that triggers binding. */
  596.     char *command;            /* Contains Tcl command to execute
  597.                      * when binding triggers. */
  598. #ifdef STk_CODE
  599.     char *str1, *str2;               /* strings used as keys in the binding 
  600.                     * table. */
  601. #else
  602.     int append;                /* 0 means replace any existing
  603.                      * binding for eventString;  1 means
  604.                      * append to that binding. */
  605. #endif
  606. {
  607.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  608.     register PatSeq *psPtr;
  609.     unsigned long eventMask;
  610. #ifdef STk_CODE
  611.     char *new;
  612.     SCM p;
  613.  
  614.     if (!STk_valid_callback(command, &p) || (p == NULL)) {
  615.        BadSpec:    
  616.          Tcl_AppendResult(interp, "bad closure specification \"",
  617.                        command, "\"", (char *) NULL);
  618.      return TCL_ERROR;
  619.     }
  620.     if (p != NULL) {
  621.       /* 
  622.        * Modify the binding to tranform it in a call with parameters set.
  623.        * It's a hack but this avoid to do this work at each binding 
  624.        * execution
  625.        */
  626.       if ((new=STk_append_callback_parameters(p)) == NULL) goto BadSpec;
  627.       /* new will be  automatically GC'ed. */
  628.       command = new;
  629.     }
  630. #endif
  631.     psPtr = FindSequence(interp, bindPtr, object, eventString, 1, &eventMask);
  632.     if (psPtr == NULL) {
  633.     return 0;
  634.     }
  635. #ifdef STk_CODE
  636.     {
  637. #else
  638.     if (append && (psPtr->command != NULL)) {
  639.     int length;
  640.     char *new;
  641.  
  642.     length = strlen(psPtr->command) + strlen(command) + 2;
  643.     new = (char *) ckalloc((unsigned) length);
  644.     sprintf(new, "%s\n%s", psPtr->command, command);
  645.     ckfree((char *) psPtr->command);
  646.     psPtr->command = new;
  647.     } else {
  648. #endif
  649.     if (psPtr->command != NULL) {
  650.         ckfree((char *) psPtr->command);
  651.     }
  652.     psPtr->command = (char *) ckalloc((unsigned) (strlen(command) + 1));
  653.     strcpy(psPtr->command, command);
  654.     }
  655. #ifdef STk_CODE
  656.     if (eventMask) STk_add_callback(str1, eventString, str2, p);
  657. #endif
  658.     return eventMask;
  659. }
  660.  
  661. /*
  662.  *--------------------------------------------------------------
  663.  *
  664.  * Tk_DeleteBinding --
  665.  *
  666.  *    Remove an event binding from a binding table.
  667.  *
  668.  * Results:
  669.  *    The result is a standard Tcl return value.  If an error
  670.  *    occurs then interp->result will contain an error message.
  671.  *
  672.  * Side effects:
  673.  *    The binding given by object and eventString is removed
  674.  *    from bindingTable.
  675.  *
  676.  *--------------------------------------------------------------
  677.  */
  678.  
  679. int
  680. Tk_DeleteBinding(interp, bindingTable, object, eventString)
  681.     Tcl_Interp *interp;            /* Used for error reporting. */
  682.     Tk_BindingTable bindingTable;    /* Table in which to delete binding. */
  683.     ClientData object;            /* Token for object with which binding
  684.                      * is associated. */
  685.     char *eventString;            /* String describing event sequence
  686.                      * that triggers binding. */
  687. {
  688.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  689.     register PatSeq *psPtr, *prevPtr;
  690.     unsigned long eventMask;
  691.     Tcl_HashEntry *hPtr;
  692.  
  693.     psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &eventMask);
  694.     if (psPtr == NULL) {
  695.     Tcl_ResetResult(interp);
  696.     return TCL_OK;
  697.     }
  698.  
  699.     /*
  700.      * Unlink the binding from the list for its object, then from the
  701.      * list for its pattern.
  702.      */
  703.  
  704.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  705.     if (hPtr == NULL) {
  706.     panic("Tk_DeleteBinding couldn't find object table entry");
  707.     }
  708.     prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  709.     if (prevPtr == psPtr) {
  710.     Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
  711.     } else {
  712.     for ( ; ; prevPtr = prevPtr->nextObjPtr) {
  713.         if (prevPtr == NULL) {
  714.         panic("Tk_DeleteBinding couldn't find on object list");
  715.         }
  716.         if (prevPtr->nextObjPtr == psPtr) {
  717.         prevPtr->nextObjPtr = psPtr->nextObjPtr;
  718.         break;
  719.         }
  720.     }
  721.     }
  722.     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  723.     if (prevPtr == psPtr) {
  724.     if (psPtr->nextSeqPtr == NULL) {
  725.         Tcl_DeleteHashEntry(psPtr->hPtr);
  726.     } else {
  727.         Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  728.     }
  729.     } else {
  730.     for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  731.         if (prevPtr == NULL) {
  732.         panic("Tk_DeleteBinding couldn't find on hash chain");
  733.         }
  734.         if (prevPtr->nextSeqPtr == psPtr) {
  735.         prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  736.         break;
  737.         }
  738.     }
  739.     }
  740.     ckfree((char *) psPtr->command);
  741.     ckfree((char *) psPtr);
  742.     return TCL_OK;
  743. }
  744.  
  745. /*
  746.  *--------------------------------------------------------------
  747.  *
  748.  * Tk_GetBinding --
  749.  *
  750.  *    Return the command associated with a given event string.
  751.  *
  752.  * Results:
  753.  *    The return value is a pointer to the command string
  754.  *    associated with eventString for object in the domain
  755.  *    given by bindingTable.  If there is no binding for
  756.  *    eventString, or if eventString is improperly formed,
  757.  *    then NULL is returned and an error message is left in
  758.  *    interp->result.  The return value is semi-static:  it
  759.  *    will persist until the binding is changed or deleted.
  760.  *
  761.  * Side effects:
  762.  *    None.
  763.  *
  764.  *--------------------------------------------------------------
  765.  */
  766.  
  767. char *
  768. Tk_GetBinding(interp, bindingTable, object, eventString)
  769.     Tcl_Interp *interp;            /* Interpreter for error reporting. */
  770.     Tk_BindingTable bindingTable;    /* Table in which to look for
  771.                      * binding. */
  772.     ClientData object;            /* Token for object with which binding
  773.                      * is associated. */
  774.     char *eventString;            /* String describing event sequence
  775.                      * that triggers binding. */
  776. {
  777.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  778.     register PatSeq *psPtr;
  779.     unsigned long eventMask;
  780.  
  781.     psPtr = FindSequence(interp, bindPtr, object, eventString, 0, &eventMask);
  782.     if (psPtr == NULL) {
  783.     return NULL;
  784.     }
  785.     return psPtr->command;
  786. }
  787.  
  788. /*
  789.  *--------------------------------------------------------------
  790.  *
  791.  * Tk_GetAllBindings --
  792.  *
  793.  *    Return a list of event strings for all the bindings
  794.  *    associated with a given object.
  795.  *
  796.  * Results:
  797.  *    There is no return value.  Interp->result is modified to
  798.  *    hold a Tcl list with one entry for each binding associated
  799.  *    with object in bindingTable.  Each entry in the list
  800.  *    contains the event string associated with one binding.
  801.  *
  802.  * Side effects:
  803.  *    None.
  804.  *
  805.  *--------------------------------------------------------------
  806.  */
  807.  
  808. void
  809. Tk_GetAllBindings(interp, bindingTable, object)
  810.     Tcl_Interp *interp;            /* Interpreter returning result or
  811.                      * error. */
  812.     Tk_BindingTable bindingTable;    /* Table in which to look for
  813.                      * bindings. */
  814.     ClientData object;            /* Token for object. */
  815.  
  816. {
  817.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  818.     register PatSeq *psPtr;
  819.     register Pattern *patPtr;
  820.     Tcl_HashEntry *hPtr;
  821.     Tcl_DString ds;
  822.     char c, buffer[10];
  823.     int patsLeft, needMods;
  824.     register ModInfo *modPtr;
  825.     register EventInfo *eiPtr;
  826.  
  827.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  828.     if (hPtr == NULL) {
  829.     return;
  830.     }
  831.     Tcl_DStringInit(&ds);
  832. #ifdef STk_CODE
  833.     Tcl_AppendResult(interp, "(", NULL);
  834. #endif
  835.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  836.         psPtr = psPtr->nextObjPtr) {
  837.     Tcl_DStringSetLength(&ds, 0);
  838.  
  839.     /*
  840.      * For each binding, output information about each of the
  841.      * patterns in its sequence.  The order of the patterns in
  842.      * the sequence is backwards from the order in which they
  843.      * must be output.
  844.      */
  845.  
  846.     for (patsLeft = psPtr->numPats,
  847.         patPtr = &psPtr->pats[psPtr->numPats - 1];
  848.         patsLeft > 0; patsLeft--, patPtr--) {
  849.  
  850.         /*
  851.          * Check for simple case of an ASCII character.
  852.          */
  853.  
  854.         if ((patPtr->eventType == KeyPress)
  855.             && (patPtr->needMods == 0)
  856.             && (patPtr->detail < 128)
  857.             && isprint(UCHAR(patPtr->detail))
  858.             && (patPtr->detail != '<')
  859.             && (patPtr->detail != ' ')) {
  860.  
  861.         c = patPtr->detail;
  862.         Tcl_DStringAppend(&ds, &c, 1);
  863.         continue;
  864.         }
  865.  
  866.         /*
  867.          * It's a more general event specification.  First check
  868.          * for "Double" or "Triple", then modifiers, then event type,
  869.          * then keysym or button detail.
  870.          */
  871.  
  872. #ifdef STk_CODE
  873.         Tcl_DStringAppend(&ds, "\"<", 2);
  874. #else
  875.         Tcl_DStringAppend(&ds, "<", 1);
  876. #endif
  877.         if ((patsLeft > 1) && (memcmp((char *) patPtr,
  878.             (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
  879.         patsLeft--;
  880.         patPtr--;
  881.         if ((patsLeft > 1) && (memcmp((char *) patPtr,
  882.             (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
  883.             patsLeft--;
  884.             patPtr--;
  885.             Tcl_DStringAppend(&ds, "Triple-", 7);
  886.         } else {
  887.             Tcl_DStringAppend(&ds, "Double-", 7);
  888.         }
  889.         }
  890.  
  891.         for (needMods = patPtr->needMods, modPtr = modArray;
  892.             needMods != 0; modPtr++) {
  893.         if (modPtr->mask & needMods) {
  894.             needMods &= ~modPtr->mask;
  895.             Tcl_DStringAppend(&ds, modPtr->name, -1);
  896.             Tcl_DStringAppend(&ds, "-", 1);
  897.         }
  898.         }
  899.  
  900.         for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
  901.         if (eiPtr->type == patPtr->eventType) {
  902.             Tcl_DStringAppend(&ds, eiPtr->name, -1);
  903.             if (patPtr->detail != 0) {
  904.             Tcl_DStringAppend(&ds, "-", 1);
  905.             }
  906.             break;
  907.         }
  908.         }
  909.  
  910.         if (patPtr->detail != 0) {
  911.         if ((patPtr->eventType == KeyPress)
  912.             || (patPtr->eventType == KeyRelease)) {
  913.             char *string;
  914.  
  915.             string = TkKeysymToString((KeySym) patPtr->detail);
  916.             if (string != NULL) {
  917.             Tcl_DStringAppend(&ds, string, -1);
  918.             }
  919.         } else {
  920.             sprintf(buffer, "%d", patPtr->detail);
  921.             Tcl_DStringAppend(&ds, buffer, -1);
  922.         }
  923.         }
  924. #ifdef STk_CODE
  925.         Tcl_DStringAppend(&ds, ">\"", 2);
  926. #else
  927.         Tcl_DStringAppend(&ds, ">", 1);
  928. #endif
  929.     }
  930.     Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
  931.     }
  932. #ifdef STk_CODE
  933.     Tcl_AppendResult(interp, ")", NULL);
  934. #endif
  935.     Tcl_DStringFree(&ds);
  936. }
  937.  
  938. /*
  939.  *--------------------------------------------------------------
  940.  *
  941.  * Tk_DeleteAllBindings --
  942.  *
  943.  *    Remove all bindings associated with a given object in a
  944.  *    given binding table.
  945.  *
  946.  * Results:
  947.  *    All bindings associated with object are removed from
  948.  *    bindingTable.
  949.  *
  950.  * Side effects:
  951.  *    None.
  952.  *
  953.  *--------------------------------------------------------------
  954.  */
  955.  
  956. void
  957. Tk_DeleteAllBindings(bindingTable, object)
  958.     Tk_BindingTable bindingTable;    /* Table in which to delete
  959.                      * bindings. */
  960.     ClientData object;            /* Token for object. */
  961. {
  962.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  963.     register PatSeq *psPtr, *prevPtr;
  964.     PatSeq *nextPtr;
  965.     Tcl_HashEntry *hPtr;
  966.  
  967.     hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
  968.     if (hPtr == NULL) {
  969.     return;
  970.     }
  971.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  972.         psPtr = nextPtr) {
  973.     nextPtr  = psPtr->nextObjPtr;
  974.  
  975.     /*
  976.      * Be sure to remove each binding from its hash chain in the
  977.      * pattern table.  If this is the last pattern in the chain,
  978.      * then delete the hash entry too.
  979.      */
  980.  
  981.     prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
  982.     if (prevPtr == psPtr) {
  983.         if (psPtr->nextSeqPtr == NULL) {
  984.         Tcl_DeleteHashEntry(psPtr->hPtr);
  985.         } else {
  986.         Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
  987.         }
  988.     } else {
  989.         for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
  990.         if (prevPtr == NULL) {
  991.             panic("Tk_DeleteAllBindings couldn't find on hash chain");
  992.         }
  993.         if (prevPtr->nextSeqPtr == psPtr) {
  994.             prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
  995.             break;
  996.         }
  997.         }
  998.     }
  999.     ckfree((char *) psPtr->command);
  1000.     ckfree((char *) psPtr);
  1001.     }
  1002.     Tcl_DeleteHashEntry(hPtr);
  1003. }
  1004.  
  1005. /*
  1006.  *--------------------------------------------------------------
  1007.  *
  1008.  * Tk_BindEvent --
  1009.  *
  1010.  *    This procedure is invoked to process an X event.  The
  1011.  *    event is added to those recorded for the binding table.
  1012.  *    Then each of the objects at *objectPtr is checked in
  1013.  *    order to see if it has a binding that matches the recent
  1014.  *    events.  If so, that binding is invoked and the rest of
  1015.  *    objects are skipped.
  1016.  *
  1017.  * Results:
  1018.  *    None.
  1019.  *
  1020.  * Side effects:
  1021.  *    Depends on the command associated with the matching
  1022.  *    binding.
  1023.  *
  1024.  *--------------------------------------------------------------
  1025.  */
  1026.  
  1027. void
  1028. Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
  1029.     Tk_BindingTable bindingTable;    /* Table in which to look for
  1030.                      * bindings. */
  1031.     XEvent *eventPtr;            /* What actually happened. */
  1032.     Tk_Window tkwin;            /* Window on display where event
  1033.                      * occurred (needed in order to
  1034.                      * locate display information). */
  1035.     int numObjects;            /* Number of objects at *objectPtr. */
  1036.     ClientData *objectPtr;        /* Array of one or more objects
  1037.                      * to check for a matching binding. */
  1038. {
  1039.     BindingTable *bindPtr = (BindingTable *) bindingTable;
  1040.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  1041.     TkDisplay *oldDispPtr;
  1042.     ScreenInfo *screenPtr;
  1043.     XEvent *ringPtr;
  1044.     PatSeq *matchPtr;
  1045.     PatternTableKey key;
  1046.     Tcl_HashEntry *hPtr;
  1047.     int detail, code, oldScreen;
  1048.     Tcl_Interp *interp;
  1049.     Tcl_DString scripts, savedResult;
  1050.     char *p, *end;
  1051.  
  1052.     /*
  1053.      * Ignore the event completely if it is an Enter, Leave, FocusIn,
  1054.      * or FocusOut event with detail NotifyInferior.  The reason for
  1055.      * ignoring these events is that we don't want transitions between
  1056.      * a window and its children to visible to bindings on the parent:
  1057.      * this would cause problems for mega-widgets, since the internal
  1058.      * structure of a mega-widget isn't supposed to be visible to
  1059.      * people watching the parent.
  1060.      */
  1061.  
  1062.     if ((eventPtr->type == EnterNotify)  || (eventPtr->type == LeaveNotify)) {
  1063.     if (eventPtr->xcrossing.detail == NotifyInferior) {
  1064.         return;
  1065.     }
  1066.     }
  1067.     if ((eventPtr->type == FocusIn)  || (eventPtr->type == FocusOut)) {
  1068.     if (eventPtr->xfocus.detail == NotifyInferior) {
  1069.         return;
  1070.     }
  1071.     }
  1072.  
  1073.     /*
  1074.      * Add the new event to the ring of saved events for the
  1075.      * binding table.  Two tricky points:
  1076.      *
  1077.      * 1. Combine consecutive MotionNotify events.  Do this by putting
  1078.      *    the new event *on top* of the previous event.
  1079.      * 2. If a modifier key is held down, it auto-repeats to generate
  1080.      *    continuous KeyPress and KeyRelease events.  These can flush
  1081.      *    the event ring so that valuable information is lost (such
  1082.      *    as repeated button clicks).  To handle this, check for the
  1083.      *    special case of a modifier KeyPress arriving when the previous
  1084.      *    two events are a KeyRelease and KeyPress of the same key.
  1085.      *    If this happens, mark the most recent event (the KeyRelease)
  1086.      *    invalid and put the new event on top of the event before that
  1087.      *    (the KeyPress).
  1088.      */
  1089.  
  1090.     if ((eventPtr->type == MotionNotify)
  1091.         && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
  1092.     /*
  1093.      * Don't advance the ring pointer.
  1094.      */
  1095.     } else if (eventPtr->type == KeyPress) {
  1096.     int i;
  1097.     for (i = 0; ; i++) {
  1098.         if (i >= dispPtr->numModKeyCodes) {
  1099.         goto advanceRingPointer;
  1100.         }
  1101.         if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1102.         break;
  1103.         }
  1104.     }
  1105.     ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1106.     if ((ringPtr->type != KeyRelease)
  1107.         || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1108.         goto advanceRingPointer;
  1109.     }
  1110.     if (bindPtr->curEvent <= 0) {
  1111.         i = EVENT_BUFFER_SIZE - 1;
  1112.     } else {
  1113.         i = bindPtr->curEvent - 1;
  1114.     }
  1115.     ringPtr = &bindPtr->eventRing[i];
  1116.     if ((ringPtr->type != KeyPress)
  1117.         || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
  1118.         goto advanceRingPointer;
  1119.     }
  1120.     bindPtr->eventRing[bindPtr->curEvent].type = -1;
  1121.     bindPtr->curEvent = i;
  1122.     } else {
  1123.     advanceRingPointer:
  1124.     bindPtr->curEvent++;
  1125.     if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
  1126.         bindPtr->curEvent = 0;
  1127.     }
  1128.     }
  1129.     ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1130.     memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
  1131.     detail = 0;
  1132.     bindPtr->detailRing[bindPtr->curEvent] = 0;
  1133.     if ((ringPtr->type == KeyPress) || (ringPtr->type == KeyRelease)) {
  1134.     detail = (int) GetKeySym(dispPtr, ringPtr);
  1135.     if (detail == NoSymbol) {
  1136.         detail = 0;
  1137.     }
  1138.     } else if ((ringPtr->type == ButtonPress)
  1139.         || (ringPtr->type == ButtonRelease)) {
  1140.     detail = ringPtr->xbutton.button;
  1141.     }
  1142.     bindPtr->detailRing[bindPtr->curEvent] = detail;
  1143.  
  1144.     /*
  1145.      * Loop over all the objects, finding the binding script for each
  1146.      * one.  Append all of the binding scripts, with %-sequences expanded,
  1147.      * to "scripts", with null characters separating the scripts for
  1148.      * each object.
  1149.      */
  1150.  
  1151.     Tcl_DStringInit(&scripts);
  1152.     for ( ; numObjects > 0; numObjects--, objectPtr++) {
  1153.  
  1154.     /*
  1155.      * Match the new event against those recorded in the
  1156.      * pattern table, saving the longest matching pattern.
  1157.      * For events with details (button and key events) first
  1158.      * look for a binding for the specific key or button.
  1159.      * If none is found, then look for a binding for all
  1160.      * keys or buttons (detail of 0).
  1161.      */
  1162.     
  1163.     matchPtr = NULL;
  1164.     key.object = *objectPtr;
  1165.     key.type = ringPtr->type;
  1166.     key.detail = detail;
  1167.     hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1168.     if (hPtr != NULL) {
  1169.         matchPtr = MatchPatterns(dispPtr, bindPtr,
  1170.             (PatSeq *) Tcl_GetHashValue(hPtr));
  1171.     }
  1172.     if ((detail != 0) && (matchPtr == NULL)) {
  1173.         key.detail = 0;
  1174.         hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
  1175.         if (hPtr != NULL) {
  1176.         matchPtr = MatchPatterns(dispPtr, bindPtr,
  1177.             (PatSeq *) Tcl_GetHashValue(hPtr));
  1178.         }
  1179.     }
  1180.     
  1181.     if (matchPtr != NULL) {
  1182.         ExpandPercents((TkWindow *) tkwin, matchPtr->command, eventPtr,
  1183.             (KeySym) detail, &scripts);
  1184.         Tcl_DStringAppend(&scripts, "", 1);
  1185.     }
  1186.     }
  1187.     if (Tcl_DStringLength(&scripts) == 0) {
  1188.     return;
  1189.     }
  1190.  
  1191.     /*
  1192.      * Now go back through and evaluate the script for each object,
  1193.      * in order, dealing with "break" and "continue" exceptions
  1194.      * appropriately.
  1195.      *
  1196.      * There are two tricks here:
  1197.      * 1. Bindings can be invoked from in the middle of Tcl commands,
  1198.      *    where interp->result is significant (for example, a widget
  1199.      *    might be deleted because of an error in creating it, so the
  1200.      *    result contains an error message that is eventually going to
  1201.      *    be returned by the creating command).  To preserve the result,
  1202.      *    we save it in a dynamic string.
  1203.      * 2. The binding's action can potentially delete the binding,
  1204.      *    so bindPtr may not point to anything valid once the action
  1205.      *    completes.  Thus we have to save bindPtr->interp in a
  1206.      *    local variable in order to restore the result.
  1207.      */
  1208.  
  1209.     interp = bindPtr->interp;
  1210.     Tcl_DStringInit(&savedResult);
  1211.  
  1212.     /*
  1213.      * Save information about the current screen, then invoke a script
  1214.      * if the screen has changed.
  1215.      */
  1216.  
  1217.     Tcl_DStringGetResult(interp, &savedResult);
  1218.  
  1219.     screenPtr = (ScreenInfo *) Tcl_GetAssocData(interp, "tkBind",
  1220.         (Tcl_InterpDeleteProc **) NULL);
  1221.  
  1222.     if (screenPtr == NULL) {
  1223.     screenPtr = (ScreenInfo *) ckalloc(sizeof(ScreenInfo));
  1224.     screenPtr->curDispPtr = NULL;
  1225.     screenPtr->curScreenIndex = -1;
  1226.     screenPtr->bindingDepth = 0;
  1227.     Tcl_SetAssocData(interp, "tkBind", FreeScreenInfo,
  1228.         (ClientData) screenPtr);
  1229.     }
  1230.     oldDispPtr = screenPtr->curDispPtr;
  1231.     oldScreen = screenPtr->curScreenIndex;
  1232.     if ((dispPtr != screenPtr->curDispPtr)
  1233.         || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
  1234.     screenPtr->curDispPtr = dispPtr;
  1235.     screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
  1236.     ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
  1237.     }
  1238.  
  1239.     p = Tcl_DStringValue(&scripts);
  1240.     end = p + Tcl_DStringLength(&scripts);
  1241.     while (p != end) {
  1242.     screenPtr->bindingDepth += 1;
  1243.     Tcl_AllowExceptions(interp);
  1244.     code = Tcl_GlobalEval(interp, p);
  1245.     screenPtr->bindingDepth -= 1;
  1246.     if (code != TCL_OK) {
  1247.         if (code == TCL_CONTINUE) {
  1248.         /*
  1249.          * Do nothing:  just go on to the next script.
  1250.          */
  1251.         } else if (code == TCL_BREAK) {
  1252.         break;
  1253.         } else {
  1254.         Tcl_AddErrorInfo(interp, "\n    (command bound to event)");
  1255.         Tcl_BackgroundError(interp);
  1256.         break;
  1257.         }
  1258.     }
  1259.  
  1260.     /*
  1261.      * Skip over the current script and its terminating null character.
  1262.      */
  1263.  
  1264.     while (*p != 0) {
  1265.         p++;
  1266.     }
  1267.     p++;
  1268.     }
  1269.     if ((screenPtr->bindingDepth != 0) &&
  1270.             ((oldDispPtr != screenPtr->curDispPtr)
  1271.                     || (oldScreen != screenPtr->curScreenIndex))) {
  1272.  
  1273.     /*
  1274.      * Some other binding script is currently executing, but its
  1275.      * screen is no longer current.  Change the current display
  1276.      * back again.
  1277.      */
  1278.  
  1279.     screenPtr->curDispPtr = oldDispPtr;
  1280.     screenPtr->curScreenIndex = oldScreen;
  1281.     ChangeScreen(interp, oldDispPtr->name, oldScreen);
  1282.     }
  1283.     Tcl_DStringResult(interp, &savedResult);
  1284.     Tcl_DStringFree(&scripts);
  1285. }
  1286.  
  1287. /*
  1288.  *----------------------------------------------------------------------
  1289.  *
  1290.  * ChangeScreen --
  1291.  *
  1292.  *    This procedure is invoked whenever the current screen changes
  1293.  *    in an application.  It invokes a Tcl procedure named
  1294.  *    "tkScreenChanged", passing it the screen name as argument.
  1295.  *    tkScreenChanged does things like making the tkPriv variable
  1296.  *    point to an array for the current display.
  1297.  *
  1298.  * Results:
  1299.  *    None.
  1300.  *
  1301.  * Side effects:
  1302.  *    Depends on what tkScreenChanged does.  If an error occurs
  1303.  *    them tkError will be invoked.
  1304.  *
  1305.  *----------------------------------------------------------------------
  1306.  */
  1307.  
  1308. static void
  1309. ChangeScreen(interp, dispName, screenIndex)
  1310.     Tcl_Interp *interp;            /* Interpreter in which to invoke
  1311.                      * command. */
  1312.     char *dispName;            /* Name of new display. */
  1313.     int screenIndex;            /* Index of new screen. */
  1314. {
  1315. #ifdef STk_CODE
  1316.     char command[200];
  1317.     int code;
  1318.  
  1319.     sprintf(command, "(Tk-screen-changed \"%s.%d\")", dispName, screenIndex);
  1320.     code = Tcl_GlobalEval(interp, command);
  1321. #else
  1322.     Tcl_DString cmd;
  1323.     int code;
  1324.     char screen[30];
  1325.  
  1326.     Tcl_DStringInit(&cmd);
  1327.     Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
  1328.     Tcl_DStringAppend(&cmd, dispName, -1);
  1329.     sprintf(screen, ".%d", screenIndex);
  1330.     Tcl_DStringAppend(&cmd, screen, -1);
  1331.  
  1332.     code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
  1333. #endif
  1334.     if (code != TCL_OK) {
  1335.     Tcl_AddErrorInfo(interp,
  1336.         "\n    (changing screen in event binding)");
  1337.     Tcl_BackgroundError(interp);
  1338.     }
  1339. }
  1340.  
  1341. /*
  1342.  *----------------------------------------------------------------------
  1343.  *
  1344.  * FreeScreenInfo --
  1345.  *
  1346.  *    This procedure is invoked when an interpreter is deleted in
  1347.  *    order to free the ScreenInfo structure associated with the
  1348.  *    "tkBind" AssocData.
  1349.  *
  1350.  * Results:
  1351.  *    None.
  1352.  *
  1353.  * Side effects:
  1354.  *    Storage is freed.
  1355.  *
  1356.  *----------------------------------------------------------------------
  1357.  */
  1358.  
  1359. static void
  1360. FreeScreenInfo(clientData, interp)
  1361.     ClientData clientData;    /* Pointer to ScreenInfo structure. */
  1362.     Tcl_Interp *interp;        /* Interpreter that is being deleted. */
  1363. {
  1364.     ckfree((char *) clientData);
  1365. }
  1366.  
  1367. /*
  1368.  *----------------------------------------------------------------------
  1369.  *
  1370.  * FindSequence --
  1371.  *
  1372.  *    Find the entry in a binding table that corresponds to a
  1373.  *    particular pattern string, and return a pointer to that
  1374.  *    entry.
  1375.  *
  1376.  * Results:
  1377.  *    The return value is normally a pointer to the PatSeq
  1378.  *    in patternTable that corresponds to eventString.  If an error
  1379.  *    was found while parsing eventString, or if "create" is 0 and
  1380.  *    no pattern sequence previously existed, then NULL is returned
  1381.  *    and interp->result contains a message describing the problem.
  1382.  *    If no pattern sequence previously existed for eventString, then
  1383.  *    a new one is created with a NULL command field.  In a successful
  1384.  *    return, *maskPtr is filled in with a mask of the event types
  1385.  *    on which the pattern sequence depends.
  1386.  *
  1387.  * Side effects:
  1388.  *    A new pattern sequence may be created.
  1389.  *
  1390.  *----------------------------------------------------------------------
  1391.  */
  1392.  
  1393. static PatSeq *
  1394. FindSequence(interp, bindPtr, object, eventString, create, maskPtr)
  1395.     Tcl_Interp *interp;        /* Interpreter to use for error
  1396.                  * reporting. */
  1397.     BindingTable *bindPtr;    /* Table to use for lookup. */
  1398.     ClientData object;        /* Token for object(s) with which binding
  1399.                  * is associated. */
  1400.     char *eventString;        /* String description of pattern to
  1401.                  * match on.  See user documentation
  1402.                  * for details. */
  1403.     int create;            /* 0 means don't create the entry if
  1404.                  * it doesn't already exist.   Non-zero
  1405.                  * means create. */
  1406.     unsigned long *maskPtr;    /* *maskPtr is filled in with the event
  1407.                  * types on which this pattern sequence
  1408.                  * depends. */
  1409.  
  1410. {
  1411.     Pattern pats[EVENT_BUFFER_SIZE];
  1412.     int numPats;
  1413.     register char *p;
  1414.     register Pattern *patPtr;
  1415.     register PatSeq *psPtr;
  1416.     register Tcl_HashEntry *hPtr;
  1417. #define FIELD_SIZE 48
  1418.     char field[FIELD_SIZE];
  1419.     int flags, count, new;
  1420.     size_t sequenceSize;
  1421.     unsigned long eventMask;
  1422.     PatternTableKey key;
  1423.  
  1424.     /*
  1425.      *-------------------------------------------------------------
  1426.      * Step 1: parse the pattern string to produce an array
  1427.      * of Patterns.  The array is generated backwards, so
  1428.      * that the lowest-indexed pattern corresponds to the last
  1429.      * event that must occur.
  1430.      *-------------------------------------------------------------
  1431.      */
  1432.  
  1433.     p = eventString;
  1434.     flags = 0;
  1435.     eventMask = 0;
  1436.     for (numPats = 0, patPtr = &pats[EVENT_BUFFER_SIZE-1];
  1437.         numPats < EVENT_BUFFER_SIZE;
  1438.         numPats++, patPtr--) {
  1439.     patPtr->eventType = -1;
  1440.     patPtr->needMods = 0;
  1441.     patPtr->detail = 0;
  1442.     while (isspace(UCHAR(*p))) {
  1443.         p++;
  1444.     }
  1445.     if (*p == '\0') {
  1446.         break;
  1447.     }
  1448.  
  1449.     /*
  1450.      * Handle simple ASCII characters.
  1451.      */
  1452.  
  1453.     if (*p != '<') {
  1454.         char string[2];
  1455.  
  1456.         patPtr->eventType = KeyPress;
  1457.         eventMask |= KeyPressMask;
  1458.         string[0] = *p;
  1459.         string[1] = 0;
  1460.         patPtr->detail = TkStringToKeysym(string);
  1461.         if (patPtr->detail == NoSymbol) {
  1462.         if (isprint(UCHAR(*p))) {
  1463.             patPtr->detail = *p;
  1464.         } else {
  1465.             sprintf(interp->result,
  1466.                 "bad ASCII character 0x%x", (unsigned char) *p);
  1467.             return NULL;
  1468.         }
  1469.         }
  1470.         p++;
  1471.         continue;
  1472.     }
  1473.  
  1474.     /*
  1475.      * A fancier event description.  Must consist of
  1476.      * 1. open angle bracket.
  1477.      * 2. any number of modifiers, each followed by spaces
  1478.      *    or dashes.
  1479.      * 3. an optional event name.
  1480.      * 4. an option button or keysym name.  Either this or
  1481.      *    item 3 *must* be present;  if both are present
  1482.      *    then they are separated by spaces or dashes.
  1483.      * 5. a close angle bracket.
  1484.      */
  1485.  
  1486.     count = 1;
  1487.     p++;
  1488.     while (1) {
  1489.         register ModInfo *modPtr;
  1490.         p = GetField(p, field, FIELD_SIZE);
  1491.         hPtr = Tcl_FindHashEntry(&modTable, field);
  1492.         if (hPtr == NULL) {
  1493.         break;
  1494.         }
  1495.         modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
  1496.         patPtr->needMods |= modPtr->mask;
  1497.         if (modPtr->flags & (DOUBLE|TRIPLE)) {
  1498.         flags |= PAT_NEARBY;
  1499.         if (modPtr->flags & DOUBLE) {
  1500.             count = 2;
  1501.         } else {
  1502.             count = 3;
  1503.         }
  1504.         }
  1505.         while ((*p == '-') || isspace(UCHAR(*p))) {
  1506.         p++;
  1507.         }
  1508.     }
  1509.     hPtr = Tcl_FindHashEntry(&eventTable, field);
  1510.     if (hPtr != NULL) {
  1511.         register EventInfo *eiPtr;
  1512.         eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
  1513.         patPtr->eventType = eiPtr->type;
  1514.         eventMask |= eiPtr->eventMask;
  1515.         while ((*p == '-') || isspace(UCHAR(*p))) {
  1516.         p++;
  1517.         }
  1518.         p = GetField(p, field, FIELD_SIZE);
  1519.     }
  1520.     if (*field != '\0') {
  1521.         if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
  1522.         if (patPtr->eventType == -1) {
  1523.             patPtr->eventType = ButtonPress;
  1524.             eventMask |= ButtonPressMask;
  1525.         } else if ((patPtr->eventType == KeyPress)
  1526.             || (patPtr->eventType == KeyRelease)) {
  1527.             goto getKeysym;
  1528.         } else if ((patPtr->eventType != ButtonPress)
  1529.             && (patPtr->eventType != ButtonRelease)) {
  1530.             Tcl_AppendResult(interp, "specified button \"", field,
  1531.                 "\" for non-button event", (char *) NULL);
  1532.             return NULL;
  1533.         }
  1534.         patPtr->detail = (*field - '0');
  1535.         } else {
  1536.         getKeysym:
  1537.         patPtr->detail = TkStringToKeysym(field);
  1538.         if (patPtr->detail == NoSymbol) {
  1539.             Tcl_AppendResult(interp, "bad event type or keysym \"",
  1540.                 field, "\"", (char *) NULL);
  1541.             return NULL;
  1542.         }
  1543.         if (patPtr->eventType == -1) {
  1544.             patPtr->eventType = KeyPress;
  1545.             eventMask |= KeyPressMask;
  1546.         } else if ((patPtr->eventType != KeyPress)
  1547.             && (patPtr->eventType != KeyRelease)) {
  1548.             Tcl_AppendResult(interp, "specified keysym \"", field,
  1549.                 "\" for non-key event", (char *) NULL);
  1550.             return NULL;
  1551.         }
  1552.         }
  1553.     } else if (patPtr->eventType == -1) {
  1554.         interp->result = "no event type or button # or keysym";
  1555.         return NULL;
  1556.     }
  1557.     while ((*p == '-') || isspace(UCHAR(*p))) {
  1558.         p++;
  1559.     }
  1560.     if (*p != '>') {
  1561.         interp->result = "missing \">\" in binding";
  1562.         return NULL;
  1563.     }
  1564.     p++;
  1565.  
  1566.     /*
  1567.      * Replicate events for DOUBLE and TRIPLE.
  1568.      */
  1569.  
  1570.     if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
  1571.         patPtr[-1] = patPtr[0];
  1572.         patPtr--;
  1573.         numPats++;
  1574.         if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
  1575.         patPtr[-1] = patPtr[0];
  1576.         patPtr--;
  1577.         numPats++;
  1578.         }
  1579.     }
  1580.     }
  1581.  
  1582.     /*
  1583.      *-------------------------------------------------------------
  1584.      * Step 2: find the sequence in the binding table if it exists,
  1585.      * and add a new sequence to the table if it doesn't.
  1586.      *-------------------------------------------------------------
  1587.      */
  1588.  
  1589.     if (numPats == 0) {
  1590.     interp->result = "no events specified in binding";
  1591.     return NULL;
  1592.     }
  1593.     patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
  1594.     key.object = object;
  1595.     key.type = patPtr->eventType;
  1596.     key.detail = patPtr->detail;
  1597.     hPtr = Tcl_CreateHashEntry(&bindPtr->patternTable, (char *) &key, &new);
  1598.     sequenceSize = numPats*sizeof(Pattern);
  1599.     if (!new) {
  1600.     for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
  1601.         psPtr = psPtr->nextSeqPtr) {
  1602.         if ((numPats == psPtr->numPats)
  1603.             && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
  1604.             && (memcmp((char *) patPtr, (char *) psPtr->pats,
  1605.             sequenceSize) == 0)) {
  1606.         goto done;
  1607.         }
  1608.     }
  1609.     }
  1610.     if (!create) {
  1611.     if (new) {
  1612.         Tcl_DeleteHashEntry(hPtr);
  1613.     }
  1614.     Tcl_AppendResult(interp, "no binding exists for \"",
  1615.         eventString, "\"", (char *) NULL);
  1616.     return NULL;
  1617.     }
  1618.     psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
  1619.         + (numPats-1)*sizeof(Pattern)));
  1620.     psPtr->numPats = numPats;
  1621.     psPtr->command = NULL;
  1622.     psPtr->flags = flags;
  1623.     psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1624.     psPtr->hPtr = hPtr;
  1625.     Tcl_SetHashValue(hPtr, psPtr);
  1626.  
  1627.     /*
  1628.      * Link the pattern into the list associated with the object.
  1629.      */
  1630.  
  1631.     psPtr->object = object;
  1632.     hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object, &new);
  1633.     if (new) {
  1634.     psPtr->nextObjPtr = NULL;
  1635.     } else {
  1636.     psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
  1637.     }
  1638.     Tcl_SetHashValue(hPtr, psPtr);
  1639.  
  1640.     memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
  1641.  
  1642.     done:
  1643.     *maskPtr = eventMask;
  1644.     return psPtr;
  1645. }
  1646.  
  1647. /*
  1648.  *----------------------------------------------------------------------
  1649.  *
  1650.  * GetField --
  1651.  *
  1652.  *    Used to parse pattern descriptions.  Copies up to
  1653.  *    size characters from p to copy, stopping at end of
  1654.  *    string, space, "-", ">", or whenever size is
  1655.  *    exceeded.
  1656.  *
  1657.  * Results:
  1658.  *    The return value is a pointer to the character just
  1659.  *    after the last one copied (usually "-" or space or
  1660.  *    ">", but could be anything if size was exceeded).
  1661.  *    Also places NULL-terminated string (up to size
  1662.  *    character, including NULL), at copy.
  1663.  *
  1664.  * Side effects:
  1665.  *    None.
  1666.  *
  1667.  *----------------------------------------------------------------------
  1668.  */
  1669.  
  1670. static char *
  1671. GetField(p, copy, size)
  1672.     register char *p;        /* Pointer to part of pattern. */
  1673.     register char *copy;    /* Place to copy field. */
  1674.     int size;            /* Maximum number of characters to
  1675.                  * copy. */
  1676. {
  1677.     while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
  1678.         && (*p != '-') && (size > 1)) {
  1679.     *copy = *p;
  1680.     p++;
  1681.     copy++;
  1682.     size--;
  1683.     }
  1684.     *copy = '\0';
  1685.     return p;
  1686. }
  1687.  
  1688. /*
  1689.  *----------------------------------------------------------------------
  1690.  *
  1691.  * GetKeySym --
  1692.  *
  1693.  *    Given an X KeyPress or KeyRelease event, map the
  1694.  *    keycode in the event into a KeySym.
  1695.  *
  1696.  * Results:
  1697.  *    The return value is the KeySym corresponding to
  1698.  *    eventPtr, or NoSymbol if no matching Keysym could be
  1699.  *    found.
  1700.  *
  1701.  * Side effects:
  1702.  *    In the first call for a given display, keycode-to-
  1703.  *    KeySym maps get loaded.
  1704.  *
  1705.  *----------------------------------------------------------------------
  1706.  */
  1707.  
  1708. static KeySym
  1709. GetKeySym(dispPtr, eventPtr)
  1710.     register TkDisplay *dispPtr;    /* Display in which to
  1711.                      * map keycode. */
  1712.     register XEvent *eventPtr;        /* Description of X event. */
  1713. {
  1714.     KeySym sym;
  1715.     int index;
  1716.  
  1717.     /*
  1718.      * Refresh the mapping information if it's stale
  1719.      */
  1720.  
  1721.     if (dispPtr->bindInfoStale) {
  1722.     InitKeymapInfo(dispPtr);
  1723.     }
  1724.  
  1725.     /*
  1726.      * Figure out which of the four slots in the keymap vector to
  1727.      * use for this key.  Refer to Xlib documentation for more info
  1728.      * on how this computation works.
  1729.      */
  1730.  
  1731.     index = 0;
  1732.     if (eventPtr->xkey.state & dispPtr->modeModMask) {
  1733.     index = 2;
  1734.     }
  1735.     if ((eventPtr->xkey.state & ShiftMask)
  1736.         || ((dispPtr->lockUsage != LU_IGNORE)
  1737.         && (eventPtr->xkey.state & LockMask))) {
  1738.     index += 1;
  1739.     }
  1740.     sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
  1741.  
  1742.     /*
  1743.      * Special handling:  if the key was shifted because of Lock, but
  1744.      * lock is only caps lock, not shift lock, and the shifted keysym
  1745.      * isn't upper-case alphabetic, then switch back to the unshifted
  1746.      * keysym.
  1747.      */
  1748.  
  1749.     if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
  1750.         && (dispPtr->lockUsage == LU_CAPS)) {
  1751.     if (!(((sym >= XK_A) && (sym <= XK_Z))
  1752.         || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
  1753.         || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
  1754.         index &= ~1;
  1755.         sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
  1756.             index);
  1757.     }
  1758.     }
  1759.  
  1760.     /*
  1761.      * Another bit of special handling:  if this is a shifted key and there
  1762.      * is no keysym defined, then use the keysym for the unshifted key.
  1763.      */
  1764.  
  1765.     if ((index & 1) && (sym == NoSymbol)) {
  1766.     sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
  1767.             index & ~1);
  1768.     }
  1769.     return sym;
  1770. }
  1771.  
  1772. /*
  1773.  *----------------------------------------------------------------------
  1774.  *
  1775.  * MatchPatterns --
  1776.  *
  1777.  *    Given a list of pattern sequences and a list of
  1778.  *    recent events, return a pattern sequence that matches
  1779.  *    the event list.
  1780.  *
  1781.  * Results:
  1782.  *    The return value is NULL if no pattern matches the
  1783.  *    recent events from bindPtr.  If one or more patterns
  1784.  *    matches, then the longest (or most specific) matching
  1785.  *    pattern is returned.
  1786.  *
  1787.  * Side effects:
  1788.  *    None.
  1789.  *
  1790.  *----------------------------------------------------------------------
  1791.  */
  1792.  
  1793. static PatSeq *
  1794. MatchPatterns(dispPtr, bindPtr, psPtr)
  1795.     TkDisplay *dispPtr;        /* Display from which the event came. */
  1796.     BindingTable *bindPtr;    /* Information about binding table, such
  1797.                  * as ring of recent events. */
  1798.     register PatSeq *psPtr;    /* List of pattern sequences. */
  1799. {
  1800.     register PatSeq *bestPtr = NULL;
  1801.  
  1802.     /*
  1803.      * Iterate over all the pattern sequences.
  1804.      */
  1805.  
  1806.     for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
  1807.     register XEvent *eventPtr;
  1808.     register Pattern *patPtr;
  1809.     Window window;
  1810.     int *detailPtr;
  1811.     int patCount, ringCount, flags, state;
  1812.     int modMask;
  1813.  
  1814.     /*
  1815.      * Iterate over all the patterns in a sequence to be
  1816.      * sure that they all match.
  1817.      */
  1818.  
  1819.     eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1820.     detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
  1821.     window = eventPtr->xany.window;
  1822.     patPtr = psPtr->pats;
  1823.     patCount = psPtr->numPats;
  1824.     ringCount = EVENT_BUFFER_SIZE;
  1825.     while (patCount > 0) {
  1826.         if (ringCount <= 0) {
  1827.         goto nextSequence;
  1828.         }
  1829.         if (eventPtr->xany.type != patPtr->eventType) {
  1830.         /*
  1831.          * Most of the event types are considered superfluous
  1832.          * in that they are ignored if they occur in the middle
  1833.          * of a pattern sequence and have mismatching types.  The
  1834.          * only ones that cannot be ignored are ButtonPress and
  1835.          * ButtonRelease events (if the next event in the pattern
  1836.          * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
  1837.          * events (if the next pattern event is a ButtonPress or
  1838.          * ButtonRelease).  Here are some tricky cases to consider:
  1839.          * 1. Double-Button or Double-Key events.
  1840.          * 2. Double-ButtonRelease or Double-KeyRelease events.
  1841.          * 3. The arrival of various events like Enter and Leave
  1842.          *    and FocusIn and GraphicsExpose between two button
  1843.          *    presses or key presses.
  1844.          * 4. Modifier keys like Shift and Control shouldn't
  1845.          *    generate conflicts with button events.
  1846.          */
  1847.  
  1848.         if ((patPtr->eventType == KeyPress)
  1849.             || (patPtr->eventType == KeyRelease)) {
  1850.             if ((eventPtr->xany.type == ButtonPress)
  1851.                 || (eventPtr->xany.type == ButtonRelease)) {
  1852.             goto nextSequence;
  1853.             }
  1854.         } else if ((patPtr->eventType == ButtonPress)
  1855.             || (patPtr->eventType == ButtonRelease)) {
  1856.             if ((eventPtr->xany.type == KeyPress)
  1857.                 || (eventPtr->xany.type == KeyRelease)) {
  1858.             int i;
  1859.  
  1860.             /*
  1861.              * Ignore key events if they are modifier keys.
  1862.              */
  1863.  
  1864.             for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1865.                 if (dispPtr->modKeyCodes[i]
  1866.                     == eventPtr->xkey.keycode) {
  1867.                 /*
  1868.                  * This key is a modifier key, so ignore it.
  1869.                  */
  1870.                 goto nextEvent;
  1871.                 }
  1872.             }
  1873.             goto nextSequence;
  1874.             }
  1875.         }
  1876.         goto nextEvent;
  1877.         }
  1878.         if (eventPtr->xany.window != window) {
  1879.         goto nextSequence;
  1880.         }
  1881.  
  1882.         /*
  1883.          * Note: it's important for the keysym check to go before
  1884.          * the modifier check, so we can ignore unwanted modifier
  1885.          * keys before choking on the modifier check.
  1886.          */
  1887.  
  1888.         if ((patPtr->detail != 0)
  1889.             && (patPtr->detail != *detailPtr)) {
  1890.         /*
  1891.          * The detail appears not to match.  However, if the event
  1892.          * is a KeyPress for a modifier key then just ignore the
  1893.          * event.  Otherwise event sequences like "aD" never match
  1894.          * because the shift key goes down between the "a" and the
  1895.          * "D".
  1896.          */
  1897.  
  1898.         if (eventPtr->xany.type == KeyPress) {
  1899.             int i;
  1900.  
  1901.             for (i = 0; i < dispPtr->numModKeyCodes; i++) {
  1902.             if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
  1903.                 goto nextEvent;
  1904.             }
  1905.             }
  1906.         }
  1907.         goto nextSequence;
  1908.         }
  1909.         flags = flagArray[eventPtr->type];
  1910.         if (flags & KEY_BUTTON_MOTION) {
  1911.         state = eventPtr->xkey.state;
  1912.         } else if (flags & CROSSING) {
  1913.         state = eventPtr->xcrossing.state;
  1914.         } else {
  1915.         state = 0;
  1916.         }
  1917.         if (patPtr->needMods != 0) {
  1918.         modMask = patPtr->needMods;
  1919.         if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
  1920.             modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
  1921.         }
  1922.         if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
  1923.             modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
  1924.         }
  1925.         if ((state & modMask) != modMask) {
  1926.             goto nextSequence;
  1927.         }
  1928.         }
  1929.         if (psPtr->flags & PAT_NEARBY) {
  1930.         register XEvent *firstPtr;
  1931.         int timeDiff;
  1932.  
  1933.         firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
  1934.         timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
  1935.         if ((firstPtr->xkey.x_root
  1936.                 < (eventPtr->xkey.x_root - NEARBY_PIXELS))
  1937.             || (firstPtr->xkey.x_root
  1938.                 > (eventPtr->xkey.x_root + NEARBY_PIXELS))
  1939.             || (firstPtr->xkey.y_root
  1940.                 < (eventPtr->xkey.y_root - NEARBY_PIXELS))
  1941.             || (firstPtr->xkey.y_root
  1942.                 > (eventPtr->xkey.y_root + NEARBY_PIXELS))
  1943.             || (timeDiff > NEARBY_MS)) {
  1944.             goto nextSequence;
  1945.         }
  1946.         }
  1947.         patPtr++;
  1948.         patCount--;
  1949.         nextEvent:
  1950.         if (eventPtr == bindPtr->eventRing) {
  1951.         eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
  1952.         detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
  1953.         } else {
  1954.         eventPtr--;
  1955.         detailPtr--;
  1956.         }
  1957.         ringCount--;
  1958.     }
  1959.  
  1960.     /*
  1961.      * This sequence matches.  If we've already got another match,
  1962.      * pick whichever is most specific.  Detail is most important,
  1963.      * then needMods.
  1964.      */
  1965.  
  1966.     if (bestPtr != NULL) {
  1967.         register Pattern *patPtr2;
  1968.         int i;
  1969.  
  1970.         if (psPtr->numPats != bestPtr->numPats) {
  1971.         if (bestPtr->numPats > psPtr->numPats) {
  1972.             goto nextSequence;
  1973.         } else {
  1974.             goto newBest;
  1975.         }
  1976.         }
  1977.         for (i = 0, patPtr = psPtr->pats, patPtr2 = bestPtr->pats;
  1978.             i < psPtr->numPats; i++, patPtr++, patPtr2++) {
  1979.         if (patPtr->detail != patPtr2->detail) {
  1980.             if (patPtr->detail == 0) {
  1981.             goto nextSequence;
  1982.             } else {
  1983.             goto newBest;
  1984.             }
  1985.         }
  1986.         if (patPtr->needMods != patPtr2->needMods) {
  1987.             if ((patPtr->needMods & patPtr2->needMods)
  1988.                 == patPtr->needMods) {
  1989.             goto nextSequence;
  1990.             } else if ((patPtr->needMods & patPtr2->needMods)
  1991.                 == patPtr2->needMods) {
  1992.             goto newBest;
  1993.             }
  1994.         }
  1995.         }
  1996.         goto nextSequence;    /* Tie goes to newest pattern. */
  1997.     }
  1998.     newBest:
  1999.     bestPtr = psPtr;
  2000.  
  2001.     nextSequence: continue;
  2002.     }
  2003.     return bestPtr;
  2004. }
  2005.  
  2006. /*
  2007.  *--------------------------------------------------------------
  2008.  *
  2009.  * ExpandPercents --
  2010.  *
  2011.  *    Given a command and an event, produce a new command
  2012.  *    by replacing % constructs in the original command
  2013.  *    with information from the X event.
  2014.  *
  2015.  * Results:
  2016.  *    The new expanded command is appended to the dynamic string
  2017.  *    given by dsPtr.
  2018.  *
  2019.  * Side effects:
  2020.  *    None.
  2021.  *
  2022.  *--------------------------------------------------------------
  2023.  */
  2024. #ifdef STk_CODE
  2025. /* 
  2026.  * There are no more '%' in STk, but since this function is not too much modified, 
  2027.  * I prefer do the modification in place, rather than rewrite it in an #ifdef. 
  2028.  * Furthermore, patch command can be run easily on it 
  2029.  */
  2030. #endif
  2031.  
  2032. static void
  2033. ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
  2034.     TkWindow *winPtr;        /* Window where event occurred:  needed to
  2035.                  * get input context. */
  2036.     register char *before;    /* Command containing percent
  2037.                  * expressions to be replaced. */
  2038.     register XEvent *eventPtr;    /* X event containing information
  2039.                  * to be used in % replacements. */
  2040.     KeySym keySym;        /* KeySym: only relevant for
  2041.                  * KeyPress and KeyRelease events). */
  2042.     Tcl_DString *dsPtr;        /* Dynamic string in which to append
  2043.                  * new command. */
  2044. {
  2045.     int spaceNeeded, cvtFlags;    /* Used to substitute string as proper Tcl
  2046.                  * list element. */
  2047.     int number, flags, length;
  2048. #define NUM_SIZE 40
  2049.     register char *string;
  2050.     char numStorage[NUM_SIZE+1];
  2051.  
  2052.     if (eventPtr->type < TK_LASTEVENT) {
  2053.     flags = flagArray[eventPtr->type];
  2054.     } else {
  2055.     flags = 0;
  2056.     }
  2057. #ifdef STk_CODE
  2058.     /* 
  2059.      * Binding is something like "(#p123abc x y)" or "(#p123abc)"
  2060.      * Skip the function "name"
  2061.      */
  2062.     for (string=before;
  2063.      (*string != 0) && (*string != ' ') &&  (*string != ')'); 
  2064.      string++) {
  2065.       /* Empty loop body. */
  2066.     }
  2067.     Tcl_DStringAppend(dsPtr, before, string-before);
  2068.     before = string;
  2069. #endif   
  2070.    
  2071.     while (1) {
  2072. #ifndef STk_CODE
  2073.     /*
  2074.      * Find everything up to the next % character and append it
  2075.      * to the result string.
  2076.      */
  2077.         for (string = before; (*string != 0) && (*string != '%'); string++) {
  2078.         /* Empty loop body. */
  2079.         }
  2080.     if (string != before) {
  2081.         Tcl_DStringAppend(dsPtr, before, string-before);
  2082.         before = string;
  2083.     }
  2084. #endif
  2085.     if (*before == 0) {
  2086.         break;
  2087.     }
  2088.  
  2089.     /*
  2090.      * There's a percent sequence here.  Process it.
  2091.      */
  2092.  
  2093.     number = 0;
  2094.     string = "??";
  2095. #ifdef STk_CODE
  2096.     switch (before[0]) {
  2097. #else
  2098.     switch (before[1]) {
  2099. #endif
  2100.         case '#':
  2101.         number = eventPtr->xany.serial;
  2102.         goto doNumber;
  2103.         case 'a':
  2104. #ifdef STk_CODE
  2105.         sprintf(numStorage, "#x%x", (int) eventPtr->xconfigure.above);
  2106. #else
  2107.         sprintf(numStorage, "0x%x", (int) eventPtr->xconfigure.above);
  2108. #endif
  2109.         string = numStorage;
  2110.         goto doString;
  2111.         case 'b':
  2112.         number = eventPtr->xbutton.button;
  2113.         goto doNumber;
  2114.         case 'c':
  2115.         if (flags & EXPOSE) {
  2116.             number = eventPtr->xexpose.count;
  2117.         } else if (flags & MAPPING) {
  2118.             number = eventPtr->xmapping.count;
  2119.         }
  2120.         goto doNumber;
  2121.         case 'd':
  2122.         if (flags & (CROSSING|FOCUS)) {
  2123.             if (flags & FOCUS) {
  2124.             number = eventPtr->xfocus.detail;
  2125.             } else {
  2126.             number = eventPtr->xcrossing.detail;
  2127.             }
  2128.             switch (number) {
  2129.             case NotifyAncestor:
  2130.                 string = "NotifyAncestor";
  2131.                 break;
  2132.             case NotifyVirtual:
  2133.                 string = "NotifyVirtual";
  2134.                 break;
  2135.             case NotifyInferior:
  2136.                 string = "NotifyInferior";
  2137.                 break;
  2138.             case NotifyNonlinear:
  2139.                 string = "NotifyNonlinear";
  2140.                 break;
  2141.             case NotifyNonlinearVirtual:
  2142.                 string = "NotifyNonlinearVirtual";
  2143.                 break;
  2144.             case NotifyPointer:
  2145.                 string = "NotifyPointer";
  2146.                 break;
  2147.             case NotifyPointerRoot:
  2148.                 string = "NotifyPointerRoot";
  2149.                 break;
  2150.             case NotifyDetailNone:
  2151.                 string = "NotifyDetailNone";
  2152.                 break;
  2153.             }
  2154.         } else if (flags & CONFIG_REQ) {
  2155.             switch (eventPtr->xconfigurerequest.detail) {
  2156.             case Above:
  2157.                 string = "Above";
  2158.                 break;
  2159.             case Below:
  2160.                 string = "Below";
  2161.                 break;
  2162.             case TopIf:
  2163.                 string = "TopIf";
  2164.                 break;
  2165.             case BottomIf:
  2166.                 string = "BottomIf";
  2167.                 break;
  2168.             case Opposite:
  2169.                 string = "Opposite";
  2170.                 break;
  2171.             }
  2172.         }
  2173.         goto doString;
  2174.         case 'f':
  2175. #ifdef STk_CODE
  2176.           string = (eventPtr->xcrossing.focus) ? "#t" : "#f";
  2177.           goto doSymbol;
  2178. #else
  2179.         number = eventPtr->xcrossing.focus;
  2180.         goto doNumber;
  2181. #endif
  2182.         case 'h':
  2183.         if (flags & EXPOSE) {
  2184.             number = eventPtr->xexpose.height;
  2185.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  2186.             number = eventPtr->xconfigure.height;
  2187.         } else if (flags & RESIZE_REQ) {
  2188.             number = eventPtr->xresizerequest.height;
  2189.         }
  2190.         goto doNumber;
  2191.         case 'k':
  2192.         number = eventPtr->xkey.keycode;
  2193.         goto doNumber;
  2194.         case 'm':
  2195.         if (flags & CROSSING) {
  2196.             number = eventPtr->xcrossing.mode;
  2197.         } else if (flags & FOCUS) {
  2198.             number = eventPtr->xfocus.mode;
  2199.         }
  2200.         switch (number) {
  2201.             case NotifyNormal:
  2202.             string = "NotifyNormal";
  2203.             break;
  2204.             case NotifyGrab:
  2205.             string = "NotifyGrab";
  2206.             break;
  2207.             case NotifyUngrab:
  2208.             string = "NotifyUngrab";
  2209.             break;
  2210.             case NotifyWhileGrabbed:
  2211.             string = "NotifyWhileGrabbed";
  2212.             break;
  2213.         }
  2214.         goto doString;
  2215.         case 'o':
  2216.         if (flags & CREATE) {
  2217.             number = eventPtr->xcreatewindow.override_redirect;
  2218.         } else if (flags & MAP) {
  2219.             number = eventPtr->xmap.override_redirect;
  2220.         } else if (flags & REPARENT) {
  2221.             number = eventPtr->xreparent.override_redirect;
  2222.         } else if (flags & CONFIG) {
  2223.             number = eventPtr->xconfigure.override_redirect;
  2224.         }
  2225. #ifdef STk_CODE
  2226.         string = number ? "#t" : "#f";
  2227.         goto doSymbol;
  2228. #else
  2229.         goto doNumber;
  2230. #endif
  2231.         case 'p':
  2232.         switch (eventPtr->xcirculate.place) {
  2233.             case PlaceOnTop:
  2234.             string = "PlaceOnTop";
  2235.             break;
  2236.             case PlaceOnBottom:
  2237.             string = "PlaceOnBottom";
  2238.             break;
  2239.         }
  2240.         goto doString;
  2241.         case 's':
  2242.         if (flags & KEY_BUTTON_MOTION) {
  2243.             number = eventPtr->xkey.state;
  2244.         } else if (flags & CROSSING) {
  2245.             number = eventPtr->xcrossing.state;
  2246.         } else if (flags & VISIBILITY) {
  2247.             switch (eventPtr->xvisibility.state) {
  2248.             case VisibilityUnobscured:
  2249.                 string = "VisibilityUnobscured";
  2250.                 break;
  2251.             case VisibilityPartiallyObscured:
  2252.                 string = "VisibilityPartiallyObscured";
  2253.                 break;
  2254.             case VisibilityFullyObscured:
  2255.                 string = "VisibilityFullyObscured";
  2256.                 break;
  2257.             }
  2258.             goto doString;
  2259.         }
  2260.         goto doNumber;
  2261.         case 't':
  2262.         if (flags & PROP) {
  2263.             number = (int) eventPtr->xproperty.time;
  2264.         } else if (flags & SEL_CLEAR) {
  2265.             number = (int) eventPtr->xselectionclear.time;
  2266.         } else if (flags & KEY_BUTTON_MOTION) {
  2267.             number = (int) eventPtr->xkey.time;
  2268.         } else if (flags & SEL_REQ) {
  2269.             number = (int) eventPtr->xselectionrequest.time;
  2270.         } else if (flags & SEL_NOTIFY) {
  2271.             number = (int) eventPtr->xselection.time;
  2272.         } else if (flags & CROSSING) {
  2273.             number = (int) eventPtr->xcrossing.time;
  2274.         }
  2275.         goto doNumber;
  2276.         case 'v':
  2277.         number = eventPtr->xconfigurerequest.value_mask;
  2278.         goto doNumber;
  2279.         case 'w':
  2280.         if (flags & EXPOSE) {
  2281.             number = eventPtr->xexpose.width;
  2282.         } else if (flags & (CONFIG|CONFIG_REQ)) {
  2283.             number = eventPtr->xconfigure.width;
  2284.         } else if (flags & RESIZE_REQ) {
  2285.             number = eventPtr->xresizerequest.width;
  2286.         }
  2287.         goto doNumber;
  2288.         case 'x':
  2289.         if (flags & KEY_BUTTON_MOTION) {
  2290.             number = eventPtr->xkey.x;
  2291.         } else if (flags & EXPOSE) {
  2292.             number = eventPtr->xexpose.x;
  2293.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  2294.             number = eventPtr->xcreatewindow.x;
  2295.         } else if (flags & REPARENT) {
  2296.             number = eventPtr->xreparent.x;
  2297.         } else if (flags & CROSSING) {
  2298.             number = eventPtr->xcrossing.x;
  2299.         }
  2300.         goto doNumber;
  2301.         case 'y':
  2302.         if (flags & KEY_BUTTON_MOTION) {
  2303.             number = eventPtr->xkey.y;
  2304.         } else if (flags & EXPOSE) {
  2305.             number = eventPtr->xexpose.y;
  2306.         } else if (flags & (CREATE|CONFIG|GRAVITY|CONFIG_REQ)) {
  2307.             number = eventPtr->xcreatewindow.y;
  2308.         } else if (flags & REPARENT) {
  2309.             number = eventPtr->xreparent.y;
  2310.         } else if (flags & CROSSING) {
  2311.             number = eventPtr->xcrossing.y;
  2312.  
  2313.         }
  2314.         goto doNumber;
  2315.         case 'A':
  2316.         if ((eventPtr->type == KeyPress)
  2317.             || (eventPtr->type == KeyRelease)) {
  2318.             int numChars;
  2319.  
  2320.             /*
  2321.              * If we're using input methods and this is a keypress
  2322.              * event, invoke XmbLookupString.  Otherwise just use
  2323.              * the older XLookupString.
  2324.              */
  2325.  
  2326. #ifdef TK_USE_INPUT_METHODS
  2327.             Status status;
  2328.             if ((winPtr->inputContext != NULL)
  2329.                 && (eventPtr->type == KeyPress)) {
  2330.                         numChars = XmbLookupString(winPtr->inputContext,
  2331.                                 &eventPtr->xkey, numStorage, NUM_SIZE,
  2332.                                 (KeySym *) NULL, &status);
  2333.             if ((status != XLookupChars)
  2334.                 && (status != XLookupBoth)) {
  2335.                 numChars = 0;
  2336.             }
  2337.                     } else {
  2338.                         numChars = XLookupString(&eventPtr->xkey, numStorage,
  2339.                                 NUM_SIZE, (KeySym *) NULL,
  2340.                                 (XComposeStatus *) NULL);
  2341.             }
  2342. #else /* TK_USE_INPUT_METHODS */
  2343.             numChars = XLookupString(&eventPtr->xkey, numStorage,
  2344.                 NUM_SIZE, (KeySym *) NULL,
  2345.                 (XComposeStatus *) NULL);
  2346. #endif /* TK_USE_INPUT_METHODS */
  2347.             numStorage[numChars] = '\0';
  2348.             string = numStorage;
  2349.         }
  2350.         goto doString;
  2351.         case 'B':
  2352.         number = eventPtr->xcreatewindow.border_width;
  2353.         goto doNumber;
  2354.         case 'E':
  2355.         number = (int) eventPtr->xany.send_event;
  2356.         goto doNumber;
  2357.         case 'K':
  2358.         if ((eventPtr->type == KeyPress)
  2359.             || (eventPtr->type == KeyRelease)) {
  2360.             char *name;
  2361.  
  2362.             name = TkKeysymToString(keySym);
  2363.             if (name != NULL) {
  2364.             string = name;
  2365.             }
  2366.         }
  2367.         goto doString;
  2368.         case 'N':
  2369.         number = (int) keySym;
  2370.         goto doNumber;
  2371.         case 'R':
  2372.         number = (int) eventPtr->xkey.root;
  2373.         goto doNumber;
  2374.         case 'S':
  2375. #ifdef STk_CODE
  2376.         sprintf(numStorage, "#x%x", (int) eventPtr->xkey.subwindow);
  2377. #else
  2378.         sprintf(numStorage, "0x%x", (int) eventPtr->xkey.subwindow);
  2379. #endif
  2380.         string = numStorage;
  2381.         goto doString;
  2382.         case 'T':
  2383.         number = eventPtr->type;
  2384.         goto doNumber;
  2385.         case 'W': {
  2386.         Tk_Window tkwin;
  2387.  
  2388.         tkwin = Tk_IdToWindow(eventPtr->xany.display,
  2389.             eventPtr->xany.window);
  2390.         if (tkwin != NULL) {
  2391.             string = Tk_PathName(tkwin);
  2392. #ifdef STk_CODE
  2393.             if (string[1] == '\0') string = "*root*";
  2394. #endif
  2395.         } else {
  2396.             string = "??";
  2397.         }
  2398. #ifdef STk_CODE
  2399.         goto doSymbol;
  2400. #else
  2401.         goto doString;
  2402. #endif
  2403.         }
  2404.         case 'X': {
  2405.         Tk_Window tkwin;
  2406.         int x, y;
  2407.         int width, height;
  2408.  
  2409.         number = eventPtr->xkey.x_root;
  2410.         tkwin = Tk_IdToWindow(eventPtr->xany.display,
  2411.             eventPtr->xany.window);
  2412.         if (tkwin != NULL) {
  2413.             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  2414.             number -= x;
  2415.         }
  2416.         goto doNumber;
  2417.         }
  2418.         case 'Y': {
  2419.         Tk_Window tkwin;
  2420.         int x, y;
  2421.         int width, height;
  2422.  
  2423.         number = eventPtr->xkey.y_root;
  2424.         tkwin = Tk_IdToWindow(eventPtr->xany.display,
  2425.             eventPtr->xany.window);
  2426.         if (tkwin != NULL) {
  2427.             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
  2428.             number -= y;
  2429.         }
  2430.         goto doNumber;
  2431.         }
  2432.         default:
  2433. #ifdef STk_CODE
  2434.             /* Just append the current ccharater in the result string */
  2435.         Tcl_DStringAppend(dsPtr, before, 1);
  2436.         before += 1;
  2437.         continue;
  2438. #else
  2439.         numStorage[0] = before[1];
  2440.         numStorage[1] = '\0';
  2441.         string = numStorage;
  2442.         goto doString;
  2443. #endif
  2444.     }
  2445. #ifdef STk_CODE
  2446.     doSymbol:
  2447.     {
  2448.       Tcl_DStringAppend(dsPtr, string, -1);
  2449.       before += 1;
  2450.       continue;
  2451.     }
  2452.     doString:
  2453.     {
  2454.       char *s;
  2455.  
  2456.       s = STk_stringify(string, 0);
  2457.       Tcl_DStringAppend(dsPtr, s, -1);
  2458.       free(s);
  2459.       before += 1;
  2460.       continue;
  2461.     }
  2462.     doNumber:
  2463.     {
  2464.       sprintf(numStorage, "%d", number);
  2465.       Tcl_DStringAppend(dsPtr, numStorage, -1);
  2466.       before += 1;
  2467.     }
  2468. #else
  2469.     doNumber:
  2470.     sprintf(numStorage, "%d", number);
  2471.     string = numStorage;
  2472.  
  2473.     doString:
  2474.     spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
  2475.     length = Tcl_DStringLength(dsPtr);
  2476.     Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
  2477.     spaceNeeded = Tcl_ConvertElement(string,
  2478.         Tcl_DStringValue(dsPtr) + length,
  2479.         cvtFlags | TCL_DONT_USE_BRACES);
  2480.     Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
  2481.     before += 2;
  2482. #endif
  2483.     }
  2484. }
  2485.  
  2486. /*
  2487.  *----------------------------------------------------------------------
  2488.  *
  2489.  * TkCopyAndGlobalEval --
  2490.  *
  2491.  *    This procedure makes a copy of a script then calls Tcl_GlobalEval
  2492.  *    to evaluate it.  It's used in situations where the execution of
  2493.  *    a command may cause the original command string to be reallocated.
  2494.  *
  2495.  * Results:
  2496.  *    Returns the result of evaluating script, including both a standard
  2497.  *    Tcl completion code and a string in interp->result.
  2498.  *
  2499.  * Side effects:
  2500.  *    None.
  2501.  *
  2502.  *----------------------------------------------------------------------
  2503.  */
  2504.  
  2505. int
  2506. TkCopyAndGlobalEval(interp, script)
  2507.     Tcl_Interp *interp;            /* Interpreter in which to evaluate
  2508.                      * script. */
  2509.     char *script;            /* Script to evaluate. */
  2510. {
  2511.     Tcl_DString buffer;
  2512.     int code;
  2513.  
  2514.     Tcl_DStringInit(&buffer);
  2515.     Tcl_DStringAppend(&buffer, script, -1);
  2516.     code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer));
  2517.     Tcl_DStringFree(&buffer);
  2518.     return code;
  2519. }
  2520.  
  2521. /*
  2522.  *--------------------------------------------------------------
  2523.  *
  2524.  * InitKeymapInfo --
  2525.  *
  2526.  *    This procedure is invoked to scan keymap information
  2527.  *    to recompute stuff that's important for binding, such
  2528.  *    as the modifier key (if any) that corresponds to "mode
  2529.  *    switch".
  2530.  *
  2531.  * Results:
  2532.  *    None.
  2533.  *
  2534.  * Side effects:
  2535.  *    Keymap-related information in dispPtr is updated.
  2536.  *
  2537.  *--------------------------------------------------------------
  2538.  */
  2539.  
  2540. static void
  2541. InitKeymapInfo(dispPtr)
  2542.     TkDisplay *dispPtr;        /* Display for which to recompute keymap
  2543.                  * information. */
  2544. {
  2545.     XModifierKeymap *modMapPtr;
  2546.     register KeyCode *codePtr;
  2547.     KeySym keysym;
  2548.     int count, i, j, max, arraySize;
  2549. #define KEYCODE_ARRAY_SIZE 20
  2550.  
  2551.     dispPtr->bindInfoStale = 0;
  2552.     modMapPtr = XGetModifierMapping(dispPtr->display);
  2553.  
  2554.     /*
  2555.      * Check the keycodes associated with the Lock modifier.  If
  2556.      * any of them is associated with the XK_Shift_Lock modifier,
  2557.      * then Lock has to be interpreted as Shift Lock, not Caps Lock.
  2558.      */
  2559.  
  2560.     dispPtr->lockUsage = LU_IGNORE;
  2561.     codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
  2562.     for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
  2563.     if (*codePtr == 0) {
  2564.         continue;
  2565.     }
  2566.     keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
  2567.     if (keysym == XK_Shift_Lock) {
  2568.         dispPtr->lockUsage = LU_SHIFT;
  2569.         break;
  2570.     }
  2571.     if (keysym == XK_Caps_Lock) {
  2572.         dispPtr->lockUsage = LU_CAPS;
  2573.         break;
  2574.     }
  2575.     }
  2576.  
  2577.     /*
  2578.      * Look through the keycodes associated with modifiers to see if
  2579.      * the the "mode switch", "meta", or "alt" keysyms are associated
  2580.      * with any modifiers.  If so, remember their modifier mask bits.
  2581.      */
  2582.  
  2583.     dispPtr->modeModMask = 0;
  2584.     dispPtr->metaModMask = 0;
  2585.     dispPtr->altModMask = 0;
  2586.     codePtr = modMapPtr->modifiermap;
  2587.     max = 8*modMapPtr->max_keypermod;
  2588.     for (i = 0; i < max; i++, codePtr++) {
  2589.     if (*codePtr == 0) {
  2590.         continue;
  2591.     }
  2592.     keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
  2593.     if (keysym == XK_Mode_switch) {
  2594.         dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
  2595.     }
  2596.     if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
  2597.         dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
  2598.     }
  2599.     if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
  2600.         dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
  2601.     }
  2602.     }
  2603.  
  2604.     /*
  2605.      * Create an array of the keycodes for all modifier keys.
  2606.      */
  2607.  
  2608.     if (dispPtr->modKeyCodes != NULL) {
  2609.     ckfree((char *) dispPtr->modKeyCodes);
  2610.     }
  2611.     dispPtr->numModKeyCodes = 0;
  2612.     arraySize = KEYCODE_ARRAY_SIZE;
  2613.     dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
  2614.         (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
  2615.     for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
  2616.     if (*codePtr == 0) {
  2617.         continue;
  2618.     }
  2619.  
  2620.     /*
  2621.      * Make sure that the keycode isn't already in the array.
  2622.      */
  2623.  
  2624.     for (j = 0; j < dispPtr->numModKeyCodes; j++) {
  2625.         if (dispPtr->modKeyCodes[j] == *codePtr) {
  2626.         goto nextModCode;
  2627.         }
  2628.     }
  2629.     if (dispPtr->numModKeyCodes >= arraySize) {
  2630.         KeyCode *new;
  2631.  
  2632.         /*
  2633.          * Ran out of space in the array;  grow it.
  2634.          */
  2635.  
  2636.         arraySize *= 2;
  2637.         new = (KeyCode *) ckalloc((unsigned)
  2638.             (arraySize * sizeof(KeyCode)));
  2639.         memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
  2640.             (dispPtr->numModKeyCodes * sizeof(KeyCode)));
  2641.         ckfree((char *) dispPtr->modKeyCodes);
  2642.         dispPtr->modKeyCodes = new;
  2643.     }
  2644.     dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
  2645.     dispPtr->numModKeyCodes++;
  2646.     nextModCode: continue;
  2647.     }
  2648.     XFreeModifiermap(modMapPtr);
  2649. }
  2650.  
  2651. /*
  2652.  *----------------------------------------------------------------------
  2653.  *
  2654.  * TkStringToKeysym --
  2655.  *
  2656.  *    This procedure finds the keysym associated with a given keysym
  2657.  *    name.
  2658.  *
  2659.  * Results:
  2660.  *    The return value is the keysym that corresponds to name, or
  2661.  *    NoSymbol if there is no such keysym.
  2662.  *
  2663.  * Side effects:
  2664.  *    None.
  2665.  *
  2666.  *----------------------------------------------------------------------
  2667.  */
  2668.  
  2669. KeySym
  2670. TkStringToKeysym(name)
  2671.     char *name;            /* Name of a keysym. */
  2672. {
  2673. #ifdef REDO_KEYSYM_LOOKUP
  2674.     Tcl_HashEntry *hPtr;
  2675.  
  2676.     hPtr = Tcl_FindHashEntry(&keySymTable, name);
  2677.     if (hPtr != NULL) {
  2678.     return (KeySym) Tcl_GetHashValue(hPtr);
  2679.     }
  2680. #endif /* REDO_KEYSYM_LOOKUP */
  2681.     return XStringToKeysym(name);
  2682. }
  2683.  
  2684. /*
  2685.  *----------------------------------------------------------------------
  2686.  *
  2687.  * TkKeysymToString --
  2688.  *
  2689.  *    This procedure finds the keysym name associated with a given
  2690.  *    keysym.
  2691.  *
  2692.  * Results:
  2693.  *    The return value is a pointer to a static string containing
  2694.  *    the name of the given keysym, or NULL if there is no known name.
  2695.  *
  2696.  * Side effects:
  2697.  *    None.
  2698.  *
  2699.  *----------------------------------------------------------------------
  2700.  */
  2701.  
  2702. char *
  2703. TkKeysymToString(keysym)
  2704.     KeySym keysym;
  2705. {
  2706. #ifdef REDO_KEYSYM_LOOKUP
  2707.     Tcl_HashEntry *hPtr;
  2708.  
  2709.     hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
  2710.     if (hPtr != NULL) {
  2711.     return (char *) Tcl_GetHashValue(hPtr);
  2712.     }
  2713. #endif /* REDO_KEYSYM_LOOKUP */
  2714.     return XKeysymToString(keysym);
  2715. }
  2716.